home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue47 / Clinic / NameSpc3U.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1999-06-02  |  5.1 KB  |  182 lines
  1. unit NameSpc3U;
  2.  
  3. {$ifdef Ver90} { Delphi 2.0x }
  4.   {$define DelphiLessThan3}
  5.   {$define DelphiLessThan4}
  6.   {$define DelphiLessThan5}
  7. {$endif}
  8. {$ifdef Ver93} { C++ Builder 1.0x }
  9.   {$define DelphiLessThan3}
  10.   {$define DelphiLessThan4}
  11.   {$define DelphiLessThan5}
  12. {$endif}
  13. {$ifdef Ver100} { Delphi 3.0x }
  14.   {$define DelphiLessThan4}
  15.   {$define DelphiLessThan5}
  16. {$endif}
  17. {$ifdef Ver110} { C++ Builder 3.0x }
  18.   {$define DelphiLessThan4}
  19.   {$define DelphiLessThan5}
  20. {$endif}
  21. {$ifdef Ver120} { Delphi 4.0x }
  22.   {$define DelphiLessThan5}
  23. {$endif}
  24. {$ifdef Ver125} { C++Builder 4.0x }
  25.   {$define DelphiLessThan5}
  26. {$endif}
  27.  
  28. interface
  29.  
  30. uses
  31. {$ifdef DelphiLessThan3}
  32.   SHDOCVW,
  33. {$else}
  34.   SHDocVw_TLB,
  35. {$endif}
  36.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  37.   StdCtrls, ComCtrls, OleCtrls, ExtCtrls;
  38.  
  39. type
  40.   TForm1 = class(TForm)
  41.     lstSpecialFolder: TListBox;
  42.     Panel1: TPanel;
  43.     procedure FormCreate(Sender: TObject);
  44.     procedure lstSpecialFolderClick(Sender: TObject);
  45.   private
  46.     WebBrowser: TWebBrowser;
  47.   end;
  48.  
  49. var
  50.   Form1: TForm1;
  51.  
  52. implementation
  53.  
  54. uses
  55. {$ifdef DelphiLessThan3}
  56.   OleAuto, Ole2,
  57. {$else}
  58.   ComObj, ActiveX,
  59. {$endif}
  60.   ShlObj;
  61.  
  62. {$R *.DFM}
  63.  
  64. {$ifdef DelphiLessThan3}
  65. type
  66.   OleVariant = Variant;
  67. {$endif}
  68.  
  69. var
  70.   Malloc: IMalloc;
  71. {$ifdef DelphiLessThan4}
  72.   EmptyParam: OleVariant;
  73.  
  74. const
  75.   CSIDL_INTERNET                  = $0001;
  76.   CSIDL_ALTSTARTUP                = $001d;         // DBCS
  77.   CSIDL_COMMON_ALTSTARTUP         = $001e;         // DBCS
  78.   CSIDL_COMMON_FAVORITES          = $001f;
  79.   CSIDL_INTERNET_CACHE            = $0020;
  80.   CSIDL_COOKIES                   = $0021;
  81.   CSIDL_HISTORY                   = $0022;
  82. {$endif}
  83. {$ifdef DelphiLessThan3}
  84. const
  85.   CSIDL_COMMON_STARTMENU          = $0016;
  86.   CSIDL_COMMON_PROGRAMS           = $0017;
  87.   CSIDL_COMMON_STARTUP            = $0018;
  88.   CSIDL_COMMON_DESKTOPDIRECTORY   = $0019;
  89.   CSIDL_APPDATA                   = $001a;
  90.   CSIDL_PRINTHOOD                 = $001b;
  91. {$endif}
  92.  
  93. type
  94.   TFolder = record
  95.     Name: String;
  96.     ID: Cardinal;
  97.   end;
  98. const
  99.   Folders: array[0..29] of TFolder = (
  100.     (Name: 'CSIDL_DESKTOP'; ID: CSIDL_DESKTOP),
  101.     (Name: 'CSIDL_INTERNET'; ID: CSIDL_INTERNET),
  102.     (Name: 'CSIDL_PROGRAMS'; ID: CSIDL_PROGRAMS),
  103.     (Name: 'CSIDL_CONTROLS'; ID: CSIDL_CONTROLS),
  104.     (Name: 'CSIDL_PRINTERS'; ID: CSIDL_PRINTERS),
  105.     (Name: 'CSIDL_PERSONAL'; ID: CSIDL_PERSONAL),
  106.     (Name: 'CSIDL_FAVORITES'; ID: CSIDL_FAVORITES),
  107.     (Name: 'CSIDL_STARTUP'; ID: CSIDL_STARTUP),
  108.     (Name: 'CSIDL_RECENT'; ID: CSIDL_RECENT),
  109.     (Name: 'CSIDL_SENDTO'; ID: CSIDL_SENDTO),
  110.     (Name: 'CSIDL_BITBUCKET'; ID: CSIDL_BITBUCKET),
  111.     (Name: 'CSIDL_STARTMENU'; ID: CSIDL_STARTMENU),
  112.     (Name: 'CSIDL_DESKTOPDIRECTORY'; ID: CSIDL_DESKTOPDIRECTORY),
  113.     (Name: 'CSIDL_DRIVES'; ID: CSIDL_DRIVES),
  114.     (Name: 'CSIDL_NETWORK'; ID: CSIDL_NETWORK),
  115.     (Name: 'CSIDL_NETHOOD'; ID: CSIDL_NETHOOD),
  116.     (Name: 'CSIDL_FONTS'; ID: CSIDL_FONTS),
  117.     (Name: 'CSIDL_TEMPLATES'; ID: CSIDL_TEMPLATES),
  118.     (Name: 'CSIDL_COMMON_STARTMENU'; ID: CSIDL_COMMON_STARTMENU),
  119.     (Name: 'CSIDL_COMMON_PROGRAMS'; ID: CSIDL_COMMON_PROGRAMS),
  120.     (Name: 'CSIDL_COMMON_STARTUP'; ID: CSIDL_COMMON_STARTUP),
  121.     (Name: 'CSIDL_COMMON_DESKTOPDIRECTORY'; ID: CSIDL_COMMON_DESKTOPDIRECTORY),
  122.     (Name: 'CSIDL_APPDATA'; ID: CSIDL_APPDATA),
  123.     (Name: 'CSIDL_PRINTHOOD'; ID: CSIDL_PRINTHOOD),
  124.     (Name: 'CSIDL_ALTSTARTUP'; ID: CSIDL_ALTSTARTUP),
  125.     (Name: 'CSIDL_COMMON_ALTSTARTUP'; ID: CSIDL_COMMON_ALTSTARTUP),
  126.     (Name: 'CSIDL_COMMON_FAVORITES'; ID: CSIDL_COMMON_FAVORITES),
  127.     (Name: 'CSIDL_INTERNET_CACHE'; ID: CSIDL_INTERNET_CACHE),
  128.     (Name: 'CSIDL_COOKIES'; ID: CSIDL_COOKIES),
  129.     (Name: 'CSIDL_HISTORY'; ID: CSIDL_HISTORY));
  130.  
  131. procedure TForm1.FormCreate(Sender: TObject);
  132. var
  133.   Loop: Cardinal;
  134. begin
  135.   for Loop := Low(Folders) to High(Folders) do
  136.     lstSpecialFolder.Items.AddObject(
  137.       Folders[Loop].Name, TObject(Folders[Loop].ID));
  138.   WebBrowser := TWebBrowser.Create(Self);
  139.   TControl(WebBrowser).Parent := Panel1;
  140.   WebBrowser.Align := alClient;
  141. end;
  142.  
  143. function ILGetSize(PIDL: PItemIDList): DWord; stdcall; external 'Shell32.Dll' index 152;
  144.  
  145. function PIDLToVariant(PIDL: PItemIDList): Variant;
  146. var
  147.   PIDLSize: Integer;
  148.   ArrayPtr: Pointer;
  149. begin
  150.   PIDLSize := ILGetSize(PIDL);
  151.   Result := VarArrayCreate([0, PIDLSize-1], varByte);
  152.   ArrayPtr := VarArrayLock(Result);
  153.   try
  154.     Move(PIDL^, ArrayPtr^, PIDLSize)
  155.   finally
  156.     VarArrayUnlock(Result)
  157.   end;
  158. end;
  159.  
  160. procedure TForm1.lstSpecialFolderClick(Sender: TObject);
  161. var
  162.   URL: OleVariant;
  163.   PIDL: PItemIDList;
  164. begin
  165.   OleCheck(SHGetSpecialFolderLocation(0,
  166.     Integer(lstSpecialFolder.Items.Objects[lstSpecialFolder.ItemIndex]), PIDL));
  167.   try
  168.     URL := PIDLToVariant(PIDL);
  169.     WebBrowser.Navigate2(URL, EmptyParam, EmptyParam, EmptyParam, EmptyParam);
  170.   finally
  171.     Malloc.Free(PIDL)
  172.   end
  173. end;
  174.  
  175. initialization
  176. {$ifdef DelphiLessThan4}
  177.   TVarData(EmptyParam).VType := varError;
  178.   TVarData(EmptyParam).VError := $80020004; {DISP_E_PARAMNOTFOUND}
  179. {$endif}
  180.   ShGetMalloc(Malloc);
  181. end.
  182.